home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d14 / baswind8.arc / DEMO2.BAS < prev    next >
BASIC Source File  |  1990-09-14  |  33KB  |  1,113 lines
  1. '
  2. '=============================================================================
  3. '                   DEMO OF BASWIND8 MODULES AND BWTOOLS
  4. '                   ------------------------------------
  5. '
  6. '  MODULE : DEMO2.BAS
  7. '
  8. '  BY : James P. Morgan, 5226 Via Hacienda #115 Orlando FL, 32809  U.S.A.
  9. '
  10. '                      Version 8.0, Sept 1990
  11. '                 (c) Copyright 1990 by J P Morgan
  12. '=============================================================================
  13.  
  14. '
  15. 'The following CONST may be changed to demonstrate the support of the BASWIND
  16. 'module for the QuickBasic 4.5 "DIM" syntax: DIM Array( -x to +y)
  17. '
  18. '      CONST OPTION.BASE=-1                     'test of negative subscript
  19.  
  20.        CONST OPTION.BASE=1                      'effectively default to OPTION BASE 1
  21.  
  22. 100:
  23.        KEY OFF
  24.        COLOR 7,1
  25.        CLS
  26.  
  27.        RETURN.CODE%=0                           'with BASWIND8, most all moudule return a result code
  28.  
  29. '
  30. ' arrays dimensioned as OPTION BASE 0 (in DEMO2), BUT QB45 allows Plus OR MINUS
  31. ' subscripts when the array is dimensioned, for example:
  32. '
  33. ' DIM Array( -10 TO 10)
  34. '
  35. ' All BASWIND8 Sub-programs allow for QB45 array dimensioning syntax.
  36. ' HOWEVER, ALL Subprograms 'normalize' array element selection return values,
  37. ' as if the array had been passed as dimensioned OPTION BASE 1.
  38. '
  39. ' This MUST be considered when using value returned for item that was selected
  40. ' from a window list. In other words , you are given a return value that says
  41. ' that the 'Nth' item in array was selected (ie UBOUND(Array)+(Nth.Element%-1)),
  42. ' NOT the actual subscript of the array element selected.
  43.  
  44.        YES=1
  45.        NO=0
  46.  
  47.        DIM ITEM$    (option.base TO option.base+100)
  48.        DIM TAG$     (option.base TO option.base+100)
  49.        DIM MSGDAT$  (option.base TO option.base+5)
  50.        DIM ITEMDESC$(option.base TO option.base+10)
  51.  
  52.        DIM MAXSIZE% (option.base TO option.base+15)
  53.        DIM MAXITEMS%(option.base TO option.base+15)
  54.        DIM ITEMS.ARRAY$(option.base TO option.base+5,option.base TO option.base+15)
  55.  
  56. REM    $DYNAMIC
  57.  
  58.        DIM SCRN%(4000)
  59.        DIM TAGGED%(option.base TO option.base+100)
  60.  
  61. REM    $STATIC
  62.  
  63. '
  64.        RANDOMIZE TIMER
  65.  
  66.        FILESIZE&=0&
  67.  
  68.        GOSUB INTRODUCTION
  69.  
  70. '
  71. '---------------------------------------------------------------------------------
  72. DEMO:
  73. 200:
  74. '      ERASE ITEM$
  75.  
  76.        I&=FRE("")                               'force string cleanup (G.C.)
  77.  
  78.        COLOR 7,1
  79.        CLS
  80.  
  81.        CALL MAKEWIND(5,5,22,55,2,0,7,1,1,"",RETURN.CODE%)
  82.  
  83.        COLOR 15,0
  84.        LOCATE  5,5:PRINT "               ***    POPMENU   ***                ";
  85.        COLOR 1,7
  86.  
  87.        LOCATE  7,5:PRINT " -This demo will be used to select the other demos-";
  88.        LOCATE  9,5:PRINT "You will be presented with a number of items from  ";
  89.        LOCATE 10,5:PRINT "which to select one. ALL selection items are shown.";
  90.  
  91.        GOSUB DISPLAY.HELP
  92.  
  93.        SECONDS!=3.0
  94.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  95.  
  96.        COLOR 7,1
  97.  
  98.        ITEM.MIN=LBOUND(ITEM$)                   'demonstrate LBOUND
  99.  
  100.        FOR I=ITEM.MIN TO UBOUND(ITEM$)
  101.            ITEM$(I)=""
  102.        NEXT
  103.  
  104.        ITEM$(ITEM.MIN+0)= "  Popmenu"
  105.        ITEM$(ITEM.MIN+1)= "  Poplist"
  106.        ITEM$(ITEM.MIN+2)= "  Taglist"
  107.        ITEM$(ITEM.MIN+3)= "  Popdir"
  108.        ITEM$(ITEM.MIN+4)= "  Tagdir"
  109.        ITEM$(ITEM.MIN+5)= "  Barmenu"
  110.        ITEM$(ITEM.MIN+6)= "  Menu123"
  111.        ITEM$(ITEM.MIN+7)= "  Calendar"
  112.        ITEM$(ITEM.MIN+8)= "  Calendr3"
  113.        ITEM$(ITEM.MIN+9)= "  Keycal"
  114.        ITEM$(ITEM.MIN+10)="  Caution"
  115.        ITEM$(ITEM.MIN+11)="  Question"
  116.        ITEM$(ITEM.MIN+12)="  Warning"
  117.        ITEM$(ITEM.MIN+13)="  end demo"
  118.  
  119.        SELECT.%=7                               'hi-lite the 7th item on the menu at start
  120.  
  121.        CALL POPMENU("Select Demo ...",14,ITEM$(),4,0,7,15,1,"2:61",0,SELECT.%,RETURN.CODE%)
  122.  
  123. '      ERASE ITEM$
  124.  
  125.        FOR I=ITEM.MIN TO UBOUND(ITEM$)
  126.            ITEM$(I)=""
  127.        NEXT
  128. '
  129. 250:
  130.        SELECT CASE SELECT.%
  131.               CASE 1
  132.                     GOTO DEMO
  133.               CASE 2
  134.                     GOSUB DOPOPL
  135.               CASE 3
  136.                     GOSUB DOTAGL
  137.               CASE 4
  138.                     GOSUB DOPOPD
  139.               CASE 5
  140.                     GOSUB DOTAGD
  141.               CASE 6
  142.                     GOSUB DOBAR
  143.               CASE 7
  144.                     GOSUB DO123
  145.               CASE 8
  146.                     GOSUB DOCAL
  147.               CASE 9
  148.                     GOSUB DOCAL3
  149.               CASE 10
  150.                     GOSUB DOKEY
  151.               CASE 11
  152.                     GOSUB DOCAU
  153.               CASE 12
  154.                     GOSUB DOQUE
  155.               CASE 13
  156.                     GOSUB DOWARN
  157.               CASE 14
  158.                     GOTO ENDIT
  159.               CASE ELSE
  160.                     GOTO DEMO
  161.               END SELECT
  162.  
  163.        GOTO DEMO
  164.  
  165. '
  166. '--------------------------------------------------------------------------------
  167. DOPOPL:
  168. 300:
  169.        CALL MAKEWIND(5,5,22,55,2,1,7,1,1,"",RETURN.CODE%)
  170.  
  171.        COLOR 15,0
  172.        LOCATE  5,5:PRINT "               ***    POPLIST   ***                ";
  173.        COLOR 1,7
  174.  
  175.        LOCATE  7,5:PRINT "You will be presented with a number of items from  ";
  176.        LOCATE  8,5:PRINT "which to select one. If there are more items than  ";
  177.        LOCATE  9,5:PRINT "will fit in the POPLIST window, you can scroll the ";
  178.        LOCATE 10,5:PRINT "window to view the additional items.               ";
  179.  
  180.        SECONDS!=15.0
  181.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  182.  
  183.        J=1
  184.        FOR I=OPTION.BASE TO OPTION.BASE+100
  185.            ITEM$(I)=SPACE$(18)
  186.            TEMP$="  "+CHR$(J)+"- Item # "+STR$(J)
  187.            MID$(ITEM$(I),1,LEN(TEMP$))=TEMP$
  188.            J=J+1
  189.        NEXT
  190.  
  191.        QUADRANT=0
  192.        FOR QUADRANT=0 TO 4
  193.            COLOR 7,1
  194.            CLS
  195.  
  196. '
  197. ' hi-lite the following array element, when menu displayed
  198. '
  199.            SELECT CASE QUADRANT
  200.                   CASE 0
  201.                        SELECT.%=1
  202.                   CASE 1
  203.                        SELECT.%=43
  204.                   CASE 2
  205.                        SELECT.%=78
  206.                   CASE 3
  207.                        SELECT.%=95
  208.                   CASE ELSE
  209.                        SELECT.%=51
  210.            END SELECT
  211.  
  212.            QUADRANT$=RIGHT$(STR$(QUADRANT),1)
  213.  
  214.            CALL POPLIST("Choose an Item ...",10,100,item$(),0,3,15,5,QUADRANT$,1,SELECT.%,RETURN.CODE%)
  215.  
  216.            LOCATE 25,10
  217.  
  218.            IF SELECT.%<1 THEN
  219.                PRINT "The Item Number you selected was ";"NONE";"   ";"NO item selected";
  220.            ELSE
  221.  
  222. '
  223. ' the windowing routines 'normalized' arrays to a pseudo OPTION BASE 1, so
  224. ' convert normalized 'select.%' back to ACTUAL array element,based off UBOUND
  225. ' for the array
  226. '
  227.  
  228.                PRINT "The Item Number you selected was ";SELECT.%;"   ";ITEM$(LBOUND(ITEM$)+(SELECT.%-1));
  229.            ENDIF
  230.  
  231.            SECONDS!=4.0!
  232.            CALL WAITTIME(SECONDS!,RETURN.CODE%)
  233.  
  234. '          ERASE ITEM$
  235.        NEXT
  236.  
  237.        RETURN
  238.  
  239. '
  240. '------------------------------------------------------------------------------
  241. DOTAGL:
  242. 400:
  243.        CALL MAKEWIND(5,5,22,55,2,1,7,1,1,"",RETURN.CODE%)
  244.  
  245.        COLOR 15,0
  246.        LOCATE  5,5:PRINT "               ***    TAGLIST   ***                ";
  247.        COLOR 1,7
  248.  
  249.        LOCATE  7,5:PRINT "You will be presented with a number of items from  ";
  250.        LOCATE  8,5:PRINT "which to select one or more. To select a group of  ";
  251.        LOCATE  9,5:PRINT "items, 'tag' each one by pressing 'Ins' key next to";
  252.        LOCATE 10,5:PRINT "the item. You may  'untag' an item by pressing the ";
  253.        LOCATE 11,5:PRINT " 'Del' key. To select all taged items press Enter. ";
  254.        LOCATE 13,5:PRINT "If there are more items than will fit in the window";
  255.        LOCATE 14,5:PRINT "you can scroll the window to view the other items. ";
  256.  
  257.        SECONDS!=15.0
  258.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  259.  
  260.        QUADRANT=0
  261. '      FOR QUADRANT=0 TO 4
  262.            COLOR 7,1
  263.            CLS
  264. 410:
  265.            J=1
  266.            FOR i=OPTION.BASE TO OPTION.BASE+99
  267.                ITEM$(I)=SPACE$(18)
  268.                TAGGED%(I)=0
  269.                TEMP$="  "+CHR$(J)+ "- Item # "+STR$(J)
  270.                MID$(ITEM$(I),1,LEN(TEMP$))=TEMP$
  271.                J=J+1
  272.            NEXT
  273.  
  274.            NUMTAGGED%=5                                     'dont allow more than 5
  275.  
  276.            QUADRANT$=RIGHT$(STR$(QUADRANT),1)
  277.            CALL TAGLIST("Tag or Untag",10,99,NUMTAGGED%,ITEM$(),TAGGED%(),5,0,0,7,QUADRANT$,0,RETURN.CODE%)
  278.  
  279.            LOCATE 2,3
  280.            IF NUMTAGGED%<1 THEN
  281.                 PRINT "The 0 Items you tagged were: NONE "
  282.               GOTO DOTAGL.CONT
  283.            ELSE
  284.                 PRINT "The ";NUMTAGGED%;" Items you tagged were: "
  285.            ENDIF
  286.  
  287.            LOCATE 4,5
  288.  
  289. 475:
  290.            FOR I=OPTION.BASE TO OPTION.BASE+99
  291.                LOCATE ,5
  292.                IF TAGGED%(I)=1 THEN PRINT ITEM$(I)
  293.            NEXT
  294.  
  295. DOTAGL.CONT:
  296.            SECONDS!=4.0!
  297.            CALL WAITTIME(SECONDS!,RETURN.CODE%)
  298.  
  299. '          ERASE ITEM$
  300. '          ERASE TAGGED%
  301.  
  302. '      NEXT
  303.  
  304.        RETURN
  305.  
  306. '
  307. '-----------------------------------------------------------------------------
  308. DOPOPD:
  309. 500:
  310.        CALL MAKEWIND(5,5,22,55,2,1,7,1,1,"",RETURN.CODE%)
  311.  
  312.        COLOR 15,0
  313.        LOCATE  5,5:PRINT "               ***    POPDIR    ***                ";
  314.        COLOR 1,7
  315.  
  316.        LOCATE  7,5:PRINT "This is a special case of the POPLIST routine. Here";
  317.        LOCATE  8,5:PRINT "items to be selected are from the directory of the ";
  318.        LOCATE  9,5:PRINT "disk. You specify the filespec , may include the   ";
  319.        LOCATE 10,5:PRINT "wildcard characters '?' and '*', and a directory   ";
  320.        LOCATE 11,5:PRINT "search is performed on the filespec.               ";
  321.        LOCATE 13,5:PRINT "If there are more items than will fit in the window";
  322.        LOCATE 14,5:PRINT "you can scroll the window to view the other items. ";
  323.  
  324.        SECONDS!=15.0
  325.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  326.  
  327.        QUADRANT=0
  328. '      FOR QUADRANT=0 TO 4
  329.            COLOR 7,1
  330.            CLS
  331.            INPUT "Enter File Spec: ";SEARCH$
  332.  
  333.            QUADRANT$=RIGHT$(STR$(QUADRANT),1)
  334.            SELECTFILE$=""
  335.            NUMFILES%=0
  336.            CALL POPDIR(SEARCH$,10,0,7,5,7,QUADRANT$,1,NUMFILES%,SELECTFILE$,RETURN.CODE%)
  337.  
  338. 550:
  339.            LOCATE 25,30
  340.            IF SELECTFILE$="" THEN
  341.                PRINT "Returned Value is: (no file selected)";
  342.            ELSE
  343.                LOCATE 25,10
  344.                GOSUB PRINT.FILENAME
  345.            ENDIF
  346.  
  347.            SECONDS!=15.0!
  348.            CALL WAITTIME(SECONDS!,RETURN.CODE%)
  349.  
  350. '      NEXT QUADRANT
  351.  
  352.        RETURN
  353.  
  354. '
  355. '-----------------------------------------------------------------------------
  356. DOTAGD:
  357. 600:
  358.        CALL MAKEWIND(5,5,22,55,2,1,7,1,1,"",RETURN.CODE%)
  359.  
  360.        COLOR 15,0
  361.        LOCATE  5,5:PRINT "               ***    TAGDIR    ***                ";
  362.        COLOR 1,7
  363.  
  364.        LOCATE  7,5:PRINT "This is a special case of the POPDIR routine. Here ";
  365.        LOCATE  8,5:PRINT "items to be selected are from the directory of the ";
  366.        LOCATE  9,5:PRINT "disk. You specify the filespec , may include the   ";
  367.        LOCATE 10,5:PRINT "wildcard characters '?' and '*', and a directory   ";
  368.        LOCATE 11,5:PRINT "search is performed on the filespec.               ";
  369.        LOCATE 13,5:PRINT "You will be presented with a number of items from  ";
  370.        LOCATE 14,5:PRINT "which to select one or more. To select a group of  ";
  371.        LOCATE 15,5:PRINT "items,  'tag'  each one by pressing 'Ins' key next ";
  372.        LOCATE 16,5:PRINT "to the item. To  'untag' an item , you press the   ";
  373.        LOCATE 17,5:PRINT " 'Del'  key. To select all taged items press Enter.";
  374.        LOCATE 19,5:PRINT "This would be useful for FILE MANAGER type function";
  375.        LOCATE 21,5:PRINT "If there are more items than will fit in the window";
  376.        LOCATE 22,5:PRINT "you can scroll the window to view the other items. ";
  377.  
  378.        SECONDS!=15.0
  379.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  380.  
  381.        QUADRANT=0
  382. '      FOR QUADRANT=0 TO 4
  383.            COLOR 7,1
  384.            CLS
  385.            INPUT "Enter File Spec: ";SEARCH$
  386.  
  387.            NUMTAGGED%=0
  388.  
  389.            QUADRANT$=RIGHT$(STR$(QUADRANT),1)
  390.            CALL TAGDIR(SEARCH$,10,6,0,0,7,QUADRANT$,0,NUMTAGGED%,TAG$(),RETURN.CODE%)
  391.  
  392. 650:
  393.            LOCATE 2,3
  394.            IF NUMTAGGED%<1 THEN
  395.                PRINT "The 0 Items you tagged were: NONE "
  396.            ELSE
  397.                PRINT "The ";NUMTAGGED%;" Items you tagged were: "
  398.            ENDIF
  399.  
  400.            LOCATE 4,5
  401.  
  402. '
  403. '  should this be -1 after numtagged
  404. '
  405.            FOR I=OPTION.BASE TO OPTION.BASE+NUMTAGGED%
  406.                LOCATE ,5
  407.                ASCIIZ=INSTR(TAG$(I),CHR$(0))
  408.                IF ASCIIZ>1 THEN
  409.                    PRINT LEFT$(TAG$(I),ASCIIZ)
  410.                ELSE
  411.                    PRINT TAG$(i)
  412.                ENDIF
  413.            NEXT
  414.  
  415.            SECONDS!=15.0!
  416.            CALL WAITTIME(SECONDS!,RETURN.CODE%)
  417.  
  418. '          ERASE TAG$
  419.  
  420. '      NEXT
  421.  
  422.        RETURN
  423.  
  424. '
  425. '------------------------------------------------------------------------------
  426. DOBAR:
  427. 700:
  428.        CALL MAKEWIND(5,5,22,55,2,1,7,1,1,"",RETURN.CODE%)
  429.  
  430.        COLOR 15,0
  431.        LOCATE  5,5:PRINT "               ***    BARMENU   ***                ";
  432.        COLOR 1,7
  433.  
  434.        LOCATE  7,5:PRINT "This is similar to the user interface of QuickBasic";
  435.        LOCATE  8,5:PRINT "2.0. A highlighted menu bar is display, consisting ";
  436.        LOCATE  9,5:PRINT "of various options. When a menu option is selected ";
  437.        LOCATE 10,5:PRINT "on the menu bar, a 'drop-down' menu of additional  ";
  438.        LOCATE 11,5:PRINT "options is also displayed.                         ";
  439.  
  440.        SECONDS!=15.0
  441.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  442.  
  443.        COLOR 7,1
  444.        CLS
  445.  
  446.        X=1
  447.        FOR I=OPTION.BASE TO OPTION.BASE+5
  448.            Y=0
  449.            FOR j=OPTION.BASE TO OPTION.BASE+10
  450.                ITEMS.ARRAY$(I,J)=CHR$(Y+ASC("A"))+ "-Menu"+STR$(X)+" Item"+STR$(Y+1)+" "
  451.                Y=Y+1
  452.            NEXT
  453.  
  454.            X=X+1
  455.        NEXT
  456.  
  457.        FOR I=OPTION.BASE TO OPTION.BASE+5
  458.            MAXSIZE%(I)=15
  459.            MAXITEMS%(I)=10
  460.        NEXT
  461.  
  462.        MAXITEMS%(OPTION.BASE+0)=2
  463.        MAXITEMS%(OPTION.BASE+1)=3
  464.        MAXITEMS%(OPTION.BASE+2)=5
  465.        MAXITEMS%(OPTION.BASE+3)=3
  466.        MAXITEMS%(OPTION.BASE+4)=1
  467.  
  468.        MENULINE$="| MENU#1   | MENU#2    | MENU#3    | MENU#4    | MENU#5    |"
  469.        CALL BARMENU(MENULINE$,0,7,12,5,MAXSIZE%(),MAXITEMS%(),ITEMS.ARRAY$(),MENUSLCT%,ITEMSLCT%,RETURN.CODE%)
  470.  
  471. 750:
  472.        LOCATE 25,20
  473.        PRINT "Returned Value is MENU: ";MENUSLCT%;" ITEM: ";ITEMSLCT%;"   ";
  474.  
  475.  
  476.        SECONDS!=4.0!
  477.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  478.  
  479. '      ERASE MAXSIZE%
  480. '      ERASE MAXITEMS%
  481. '      ERASE ITEMS.ARRAY$
  482.  
  483.        RETURN
  484.  
  485. '
  486. '-----------------------------------------------------------------------------
  487. DO123:
  488. 800:
  489.        CALL MAKEWIND(5,5,22,55,2,1,7,1,1,"",RETURN.CODE%)
  490.  
  491.        COLOR 15,0
  492.        LOCATE  5,5:PRINT "               ***    MENU123   ***                ";
  493.        COLOR 1,7
  494.  
  495.        LOCATE  7,5:PRINT "This is an imitation of the Lotus 1-2-3 user inter-";
  496.        LOCATE  8,5:PRINT "face. A  menu bar of various options is display.   ";
  497.        LOCATE  9,5:PRINT "On the line below the menu bar,a description of the";
  498.        LOCATE 10,5:PRINT "function of the currently highlighted option select";
  499.        LOCATE 11,5:PRINT "-ed is also displayed.                             ";
  500.  
  501.        SECONDS!=15.0
  502.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  503.  
  504.        COLOR 7,1
  505.        CLS
  506.  
  507.        MENULINE$="Format Copy Rename Delete Erase Move Discard Pop Push BigBadBillybob"
  508.        MENUFG%=7
  509.        MENUBG%=1
  510.        ITEMNUM%=10
  511.  
  512.        J=1
  513.        FOR I=OPTION.BASE TO OPTION.BASE+ITEMNUM%
  514.          ITEMDESC$(I)="This is Menu Item Number"+STR$(J)
  515.          J=J+1
  516.        NEXT
  517.  
  518.        LOCATE 3,1
  519.        PRINT STRING$(80,205)
  520.  
  521.        ITEMSLCT%=0
  522.  
  523.        CALL MENU123(MENULINE$,1,MENUFG%,MENUBG%,ITEMNUM%,ITEMDESC$(),ITEMSLCT%,RETURN.CODE%)
  524.  
  525. 850:
  526.        LOCATE  25,20
  527.        PRINT "ITEM SELECTED WAS: ";ITEMSLCT%;
  528.  
  529.        SECONDS!=4.0!
  530.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  531.  
  532. '      ERASE ITEMDESC$
  533.  
  534.        RETURN
  535.  
  536. '
  537. '-----------------------------------------------------------------------------
  538. DOCAL:
  539. 900:
  540.        CALL MAKEWIND(5,5,22,55,2,1,7,1,1,"",RETURN.CODE%)
  541.        COLOR 15,0
  542.        LOCATE  5,5:PRINT "               ***   CALENDAR   ***                ";
  543.        COLOR 1,7
  544.  
  545.        LOCATE  7,5:PRINT "This routine displays a calendar in a window, for a";
  546.        LOCATE  8,5:PRINT "given month and year.                              ";
  547.  
  548.        SECONDS!=8.0
  549.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  550.        QUADRANT=0
  551. '      FOR QUADRANT=0 TO 4
  552.            COLOR 7,1
  553.            CLS
  554.            INPUT "Month (1-12)",MONTH%
  555.            INPUT "Year (4 digit)",YEAR%
  556.  
  557.            QUADRANT$=RIGHT$(STR$(QUADRANT),1)
  558.            CALL CALENDAR(MONTH%,YEAR%,QUADRANT$,0,7,1,RETURN.CODE%)
  559.  
  560. 950:
  561.            SECONDS!=4.0!
  562.            CALL WAITTIME(SECONDS!,RETURN.CODE%)
  563.  
  564. '          NEXT QUADRANT
  565.  
  566.        RETURN
  567.  
  568. '
  569. '------------------------------------------------------------------------------
  570. DOCAL3:
  571. 1000:
  572.        CALL MAKEWIND(5,5,22,55,2,1,7,1,1,"",RETURN.CODE%)
  573.  
  574.        COLOR 15,0
  575.        LOCATE  5,5:PRINT "               ***   CALENDR3   ***                ";
  576.        COLOR 1,7
  577.  
  578.        LOCATE  7,5:PRINT "This routine displays a calendar in a window, for a";
  579.        LOCATE  8,5:PRINT "given month and year. In addition, the calendars   ";
  580.        LOCATE  9,5:PRINT "for the previous and following month is displayed. ";
  581.  
  582.        SECONDS!=10.0
  583.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  584.  
  585.        COLOR 7,1
  586.        CLS
  587.        INPUT "Month (1-12)",month%
  588.        INPUT "Year (4 digit)",year%
  589.  
  590.        CALL CALENDR3(MONTH%,YEAR%,12,0,7,1,RETURN.CODE%)
  591.  
  592. 1050:
  593.        SECONDS!=20.0!
  594.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  595.        RETURN
  596.  
  597. '
  598. '----------------------------------------------------------------------------
  599. DOKEY:
  600. 1100:
  601.        CALL MAKEWIND(5,5,22,55,2,1,7,1,1,"",RETURN.CODE%)
  602.  
  603.        COLOR 15,0
  604.        LOCATE  5,5:PRINT "               ***     KEYCAL   ***                ";
  605.        COLOR 1,7
  606.  
  607.        LOCATE  7,5:PRINT "This routine displays a calendar in a window, for a";
  608.        LOCATE  8,5:PRINT "given month and year.  However, using the cursor   ";
  609.        LOCATE  9,5:PRINT "keys, you can advance or backup months and years.  ";
  610.  
  611.        SECONDS!=10.0
  612.        CALL  WAITTIME(SECONDS!,RETURN.CODE%)
  613.  
  614.        QUADRANT=0
  615. '      FOR QUADRANT=0 TO 4
  616.            COLOR 7,1
  617.            CLS
  618.            INPUT "Month (1-12)",month%
  619.            INPUT "Year (4 digit)",year%
  620.  
  621.            PRINT "Press [ESC] or [RETURN] to exit ..."
  622.  
  623.            QUADRANT$=RIGHT$(STR$(QUADRANT),1)
  624.            CALL KEYCAL(MONTH%,YEAR%,QUADRANT$,0,7,1,RETURN.CODE%)
  625.  
  626. 1150:
  627.            SECONDS!=4.0!
  628.            CALL WAITTIME(SECONDS!,RETURN.CODE%)
  629.  
  630. '      NEXT
  631.  
  632.        RETURN
  633.  
  634. '
  635. '-----------------------------------------------------------------------------
  636. DOCAU:
  637. 1200:
  638.        CALL MAKEWIND(5,5,22,55,2,1,7,1,1,"",RETURN.CODE%)
  639.  
  640.        COLOR 15,0
  641.        LOCATE  5,5:PRINT "               ***    CAUTION   ***                ";
  642.        COLOR 1,7
  643.  
  644.        LOCATE  7,5:PRINT "This is an implementation of the new QUERY function";
  645.        LOCATE  8,5:PRINT "The windows from the 'old' BASWIND for the function";
  646.        LOCATE  9,5:PRINT "WARNING/CAUTION/QUESTION all had a common basis, so";
  647.        LOCATE 10,5:PRINT "a general purpose function was created to handle   ";
  648.        LOCATE 11,5:PRINT "this type of requirement.                          ";
  649.        LOCATE 13,5:PRINT " CAUTION displays a 'yellow' caution window and one";
  650.        LOCATE 14,5:PRINT "or more of lines of informative text. You then use ";
  651.        LOCATE 15,5:PRINT "the window to make a 'Cancel' or 'Continue' type of";
  652.        LOCATE 16,5:PRINT "decision.                                          ";
  653.  
  654.        SECONDS!=15.0
  655.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  656.  
  657.        QUADRANT=0
  658.  
  659. '      FOR QUADRANT=0 TO 4
  660.            COLOR 7,1
  661.            CLS
  662.  
  663.            MSGDAT$(OPTION.BASE+0)="You are about to convert your COLOR Monitor"
  664.            MSGDAT$(OPTION.BASE+1)="into a Monochrome Monitor."
  665.            MSGDAT$(OPTION.BASE+2)=" "
  666.            MSGDAT$(OPTION.BASE+3)="ARE YOU ABSOLUTELY SURE YOU WANT TO DO THIS?"
  667.  
  668.            RETURN.CODE%=0
  669.  
  670.            QUADRANT$=RIGHT$(STR$(QUADRANT),1)
  671.  
  672.            CALL CAUTION(4,MSGDAT$(),QUADRANT$,RETURN.CODE%)
  673.  
  674. 1250:
  675.            LOCATE 25,38
  676.  
  677.            SELECT CASE RETURN.CODE%
  678.                CASE 0
  679.                     PRINT "CANCEL";
  680.                CASE 1
  681.                     PRINT "CONTINUE";
  682.                CASE ELSE
  683.                     PRINT "ESC";
  684.            END SELECT
  685.  
  686.            SECONDS!=4.0!
  687.            CALL WAITTIME(SECONDS!,RETURN.CODE%)
  688.  
  689. '          ERASE MSGDAT$
  690.  
  691. '      NEXT
  692.  
  693.        RETURN
  694.  
  695. '
  696. '-----------------------------------------------------------------------------
  697. DOQUE:
  698. 1300:
  699.        CALL MAKEWIND(5,5,22,55,2,1,7,1,1,"",RETURN.CODE%)
  700.  
  701.        COLOR 15,0
  702.        LOCATE  5,5:PRINT "               ***   QUESTION   ***                ";
  703.        COLOR 1,7
  704.  
  705.        LOCATE  7,5:PRINT "This is an implementation of the new QUERY function";
  706.        LOCATE  8,5:PRINT "The windows from the 'old' BASWIND for the function";
  707.        LOCATE  9,5:PRINT "WARNING/CAUTION/QUESTION all had a common basis, so";
  708.        LOCATE 10,5:PRINT "a general purpose function was created to handle   ";
  709.        LOCATE 11,5:PRINT "this type of requirement.                          ";
  710.        LOCATE 13,5:PRINT " QUESTION displays a 'yellow' question window and 1";
  711.        LOCATE 14,5:PRINT "or more of lines of informative text. You then use ";
  712.        LOCATE 15,5:PRINT "the window to make a 'Yes' or 'No' type of decision";
  713.  
  714.        SECONDS!=15.0
  715.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  716.  
  717.        QUADRANT=0
  718.  
  719. '      FOR QUADRANT=0 TO 4
  720.            COLOR 7,1
  721.            CLS
  722.  
  723.            MSGDAT$(OPTION.BASE+0)="You are about to convert your COLOR Monitor"
  724.            MSGDAT$(OPTION.BASE+1)="into a Monochrome Monitor."
  725.            MSGDAT$(OPTION.BASE+2)=" "
  726.            MSGDAT$(OPTION.BASE+3)="ARE YOU ABSOLUTELY SURE YOU WANT TO DO THIS?"
  727.  
  728.            RETURN.CODE%=1
  729.  
  730.            QUADRANT$=RIGHT$(STR$(QUADRANT),1)
  731.  
  732.            CALL QUESTION(4,MSGDAT$(),QUADRANT$,RETURN.CODE%)
  733.  
  734. 1350:
  735.            LOCATE 25,38
  736.  
  737.            SELECT CASE RETURN.CODE%
  738.                CASE 0
  739.                     PRINT "NO ";
  740.                CASE 1
  741.                     PRINT "YES ";
  742.                CASE ELSE
  743.                     PRINT "ESC";
  744.            END SELECT
  745.  
  746.            SECONDS!=4.0!
  747.            CALL WAITTIME(SECONDS!,RETURN.CODE%)
  748.  
  749. '          ERASE MSGDAT$
  750.  
  751. '      NEXT
  752.  
  753.        RETURN
  754.  
  755. '
  756. '-----------------------------------------------------------------------------
  757. DOWARN:
  758. 1400:
  759.        CALL MAKEWIND(5,5,22,55,2,1,7,1,1,"",RETURN.CODE%)
  760.  
  761.        COLOR 15,0
  762.        LOCATE  5,5:PRINT "               ***    WARNING   ***                ";
  763.        COLOR 1,7
  764.  
  765.        LOCATE  7,5:PRINT "This is an implementation of the new QUERY function";
  766.        LOCATE  8,5:PRINT "The windows from the 'old' BASWIND for the function";
  767.        LOCATE  9,5:PRINT "WARNING/CAUTION/QUESTION all had a common basis, so";
  768.        LOCATE 10,5:PRINT "a general purpose function was created to handle   ";
  769.        LOCATE 11,5:PRINT "this type of requirement.                          ";
  770.        LOCATE 13,5:PRINT "  WARNING displays a  'red'  warning window and one";
  771.        LOCATE 14,5:PRINT "or more of lines of informative text. You then use ";
  772.        LOCATE 15,5:PRINT "the window to make a 'Cancel' or 'Continue' type of";
  773.        LOCATE 16,5:PRINT "decision.                                          ";
  774.  
  775.        SECONDS!=15.0
  776.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  777.  
  778.        QUADRANT=0
  779.        FOR QUADRANT=0 TO 4
  780.            COLOR 7,1
  781.            CLS
  782.  
  783.            MSGDAT$(OPTION.BASE+0)="You are about to convert your house AC voltage"
  784.            MSGDAT$(OPTION.BASE+1)="from 110 volts to 440 volts."
  785.            MSGDAT$(OPTION.BASE+2)=" "
  786.            MSGDAT$(OPTION.BASE+3)="ARE YOU ABSOLUTELY SURE YOU WANT TO DO THIS?"
  787.  
  788.            RETURN.CODE%=0
  789.  
  790.            QUADRANT$=RIGHT$(STR$(QUADRANT),1)
  791.  
  792.            CALL WARNING(4,MSGDAT$(),QUADRANT$,RETURN.CODE%)
  793. 1450:
  794.            LOCATE 25,38
  795.  
  796.            SELECT CASE RETURN.CODE%
  797.                CASE 0
  798.                     PRINT "CANCEL";
  799.                CASE 1
  800.                     PRINT "CONTINUE";
  801.                CASE ELSE
  802.                     PRINT "ESC";
  803.            END SELECT
  804.  
  805.            SECONDS!=4.0!
  806.            CALL WAITTIME(SECONDS!,RETURN.CODE%)
  807.  
  808. '          ERASE MSGDAT$
  809.  
  810.        NEXT
  811.  
  812.        RETURN
  813.  
  814. '
  815. DISPLAY.HELP:
  816. 1500:
  817.        COLOR 15,7
  818.  
  819.        LOCATE 12,5
  820.        PRINT " Function        Keyboard      Mouse";
  821.  
  822.        COLOR 9,7
  823.  
  824.        LOCATE 14,5
  825.        PRINT " Select item     ";
  826.        COLOR 6,7
  827.        PRINT "Enter         click on item":
  828.  
  829.        COLOR 9,7
  830.        LOCATE 15,5
  831.        PRINT " Abort function  ";
  832.  
  833.        COLOR 6,7
  834.        PRINT "ESC           click outside window";
  835.  
  836.        COLOR 9,7
  837.        LOCATE 16,5
  838.        PRINT " Another item    ";
  839.  
  840.        COLOR 6,7
  841.        PRINT "Cursor keys   move mouse pointer";
  842.        LOCATE 17,22
  843.        PRINT "First letter
  844.  
  845.        COLOR 9,7
  846.        LOCATE 19,5
  847.        PRINT " More items      ";
  848.        COLOR 6,7
  849.        PRINT "PgUp/PgDn     click on top/bottom";
  850.        LOCATE 20,5
  851.        PRINT "                               window frame"
  852.  
  853.        COLOR 9,7
  854.        LOCATE 21,5
  855.        PRINT " First items     ";
  856.  
  857.        COLOR 6,7
  858.        PRINT "Home";
  859.  
  860.        COLOR 9,7
  861.        LOCATE 22,5
  862.        PRINT " Last items      ";
  863.        COLOR 6,7
  864.        PRINT "End";
  865.  
  866.        RETURN
  867.  
  868. '
  869. SCROLL.WAIT:
  870. 1600:
  871.       SECONDS!=0.2
  872.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  873.        RETURN
  874.  
  875. '
  876. PRINT.FILENAME:
  877. 1700:
  878.        FILENAME$=SELECTFILE$
  879.  
  880. '
  881. ' The following code is commented out, but shows how to access a files
  882. ' attributes and convert them to a format that is workable.
  883. '
  884.  
  885. '      FILE.ATTR$=MID$(SELECTFILE$,14,1)
  886. '      FILE.ATTR=ASC(FILE.ATTR$)
  887. '
  888. '      IF (FILE.ATTR AND &H10)<>0 THEN
  889. '          FILENAME$=FILENAME$+" <DIR> "
  890. '      ENDIF
  891. '
  892. '      IF (FILE.ATTR AND &H01)<>0 THEN
  893. '          FILENAME$=FILENAME$+"  READ ONLY "
  894. '      ENDIF
  895. '
  896. '      IF (FILE.ATTR AND &H02)<>0 THEN
  897. '          FILENAME$=FILENAME$+" + HIDDEN "
  898. '      ENDIF
  899. '
  900. '      IF (FILE.ATTR AND &H04)<>0 THEN
  901. '          FILENAME$=FILENAME$+" + SYSTEM "
  902. '      ENDIF
  903. '
  904. '      IF (FILE.ATTR AND &H08)<>0 THEN
  905. '          FILENAME$=FILENAME$+" + LABEL "
  906. '      ENDIF
  907. '
  908. '      IF (FILE.ATTR AND &H20)<>0 THEN
  909. '          FILENAME$=FILENAME$+" + ARCHIVE "
  910. '      ENDIF
  911. '
  912. '      MONTH$=MID$(SELECTFILE$,17,1)
  913. '      MONTH=ASC(MONTH$) AND &HE0
  914. '      MONTH=MONTH/32
  915. '
  916. '      MONTH$=MID$(SELECTFILE$,18,1)
  917. '      MONTH.TEMP=ASC(MONTH$) AND &H01
  918. '      MONTH.TEMP=MONTH.TEMP*8
  919. '
  920. '      MONTH=MONTH+MONTH.TEMP
  921. '
  922. '      DAY$=MID$(SELECTFILE$,17,1)
  923. '      DAY=ASC(DAY$) AND &H1F
  924. '
  925. '      YEAR$=MID$(SELECTFILE$,18,1)
  926. '      YEAR=ASC(YEAR$) AND &HFE
  927. '      YEAR=YEAR/2
  928. '      YEAR=1980+YEAR
  929. '
  930. '      HOURS$=MID$(SELECTFILE$,16,1)
  931. '      HOURS=ASC(HOURS$) AND &HF8
  932. '      HOURS=HOURS/8
  933. '
  934. '      MINUTES$=MID$(SELECTFILE$,16,1)
  935. '      MINUTES=ASC(MINUTES$) AND &H03
  936. '      MINUTES=MINUTES*8
  937. '
  938. '      MINUTES$=MID$(SELECTFILE$,15,1)
  939. '      MINUTES.TEMP=ASC(MINUTES$) AND &HE0
  940. '      MINUTES.TEMP=MINUTES.TEMP/32
  941. '      MINUTES=MINUTES+MINUTES.TEMP
  942. '
  943. '      SECONDS$=MID$(SELECTFILE$,15,1)
  944. '      SECONDS=ASC(SECONDS$) AND &H1F
  945. '      SECONDS=SECONDS*2
  946. '
  947. '      FILESIZE.ADDR=VARPTR(FILESIZE&)
  948. '      POKE FILESIZE.ADDR,ASC(MID$(SELECTFILE$,19,1))
  949. '
  950. '      FILESIZE.ADDR=VARPTR(FILESIZE&)
  951. '      POKE FILESIZE.ADDR+1,ASC(MID$(SELECTFILE$,20,1))
  952. '
  953. '      FILESIZE.ADDR=VARPTR(FILESIZE&)
  954. '      POKE FILESIZE.ADDR+2,ASC(MID$(SELECTFILE$,21,1))
  955. '
  956. '      FILESIZE.ADDR=VARPTR(FILESIZE&)
  957. '      POKE FILESIZE.ADDR+3,ASC(MID$(SELECTFILE$,22,1))
  958. '
  959. '      FILESIZE$=STR$(FILESIZE&)
  960. '
  961. '      FILEDATE$=STR$(MONTH)+"-"+STR$(DAY)+"-"+STR$(YEAR)
  962. '
  963. '      FILETIME$=STR$(HOURS)+":"+STR$(MINUTES)+":"+STR$(SECONDS)
  964. '
  965. '      FILENAME$=FILENAME$+FILESIZE$+" "+FILEDATE$+" "+FILETIME$
  966.  
  967.        PRINT FILENAME$;
  968.  
  969.        RETURN
  970.  
  971. '
  972. INTRODUCTION:
  973.        FOR I=1 TO 30
  974.           ULR%=RND*17
  975.           WHILE ULR% = 0:ULR%=RND*17:WEND
  976.  
  977.           LRR%=RND*23
  978.           WHILE LRR% < ULR%:LRR%=RND*23:WEND
  979.  
  980.           ULC%=RND*60
  981.           WHILE ULC% = 0:ULC%=RND*60:WEND
  982.  
  983.           LRC%=RND*79
  984.           WHILE LRC% < ULC%:LRC%=RND*79:WEND
  985.  
  986.           FORE%=RND*15
  987.           BACK%=RND*7
  988.  
  989.           CALL MAKEWIND(ULR%,ULC%,LRR%,LRC%,2,FORE%,BACK%,0,1,"",RETURN.CODE%)
  990.  
  991.           SECONDS!=0.2
  992.           CALL WAITTIME(SECONDS!,RETURN.CODE%)
  993.  
  994.        NEXT
  995.  
  996.        SECONDS!=3.0
  997.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  998.  
  999.        CALL MAKEWIND(9,15,16,65,2,0,7,0,1,"",RETURN.CODE%)
  1000.  
  1001. '
  1002.         COLOR 0,7
  1003.         CALL SCROLL(9,15,16,65,1,1,"     Introducing ...",RETURN.CODE%)
  1004.         GOSUB SCROLL.WAIT
  1005.  
  1006.         CALL SCROLL(9,15,16,65,1,1," ",RETURN.CODE%)
  1007.         GOSUB SCROLL.WAIT
  1008.  
  1009.         CALL SCROLL(9,15,16,65,1,1,"                  Window Tools",RETURN.CODE%)
  1010.         GOSUB SCROLL.WAIT
  1011.  
  1012.         CALL SCROLL(9,15,16,65,1,1," ",RETURN.CODE%)
  1013.         GOSUB SCROLL.WAIT
  1014.  
  1015.         CALL SCROLL(9,15,16,65,1,1,"     A collection of useful routines based on",RETURN.CODE%)
  1016.         GOSUB SCROLL.WAIT
  1017.  
  1018.         CALL SCROLL(9,15,16,65,1,1,"     BASWIND8 and designed to perform powerful",RETURN.CODE%)
  1019.         GOSUB SCROLL.WAIT
  1020.  
  1021.         CALL SCROLL(9,15,16,65,1,1,"     windowing functions in your programs ...",RETURN.CODE%)
  1022.         GOSUB SCROLL.WAIT
  1023.  
  1024.         CALL SCROLL(9,15,16,65,1,1," ",RETURN.CODE%)
  1025.  
  1026.         SECONDS!=10.0
  1027.         CALL WAITTIME(SECONDS!,RETURN.CODE%)
  1028.  
  1029.         CALL SCROLL(9,15,16,65,1,-1," ",RETURN.CODE%)
  1030.         GOSUB SCROLL.WAIT
  1031.  
  1032.         CALL SCROLL(9,15,16,65,1,-1," ",RETURN.CODE%)
  1033.         GOSUB SCROLL.WAIT
  1034.  
  1035.         CALL SCROLL(9,15,16,65,1,-1," ",RETURN.CODE%)
  1036.         GOSUB SCROLL.WAIT
  1037.  
  1038.         CALL SCROLL(9,15,16,65,1,-1," ",RETURN.CODE%)
  1039.         GOSUB SCROLL.WAIT
  1040.  
  1041.         CALL SCROLL(9,15,16,65,1,-1,"      ...  Stand by FOR a complete demo ...",RETURN.CODE%)
  1042.         GOSUB SCROLL.WAIT
  1043.  
  1044.         CALL SCROLL(9,15,16,65,1,-1," ",RETURN.CODE%)
  1045.         GOSUB SCROLL.WAIT
  1046.  
  1047.         CALL SCROLL(9,15,16,65,1,-1," ",RETURN.CODE%)
  1048.         GOSUB SCROLL.WAIT
  1049.  
  1050.         CALL SCROLL(9,15,16,65,1,-1," ",RETURN.CODE%)
  1051.  
  1052.        SECONDS!=4.0!
  1053.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  1054.  
  1055.        RETURN
  1056. '
  1057. '-----------------------------------------------------------------------------
  1058. ENDIT:
  1059. 1800:
  1060.        COLOR 7,1
  1061.        CLS
  1062.  
  1063.        CALL MAKEWIND(9,15,16,65,2,0,7,0,1,"",RETURN.CODE%)
  1064.  
  1065.        COLOR 0,7
  1066.        CALL SCROLL(9,15,16,65,1,-1,"         !!  NOW with MS Mouse support !!",RETURN.CODE%)
  1067.        GOSUB SCROLL.WAIT
  1068.  
  1069.        CALL SCROLL(9,15,16,65,1,-1," ",RETURN.CODE%)
  1070.        GOSUB SCROLL.WAIT
  1071.  
  1072.        CALL SCROLL(9,15,16,65,1,-1,"                   QuickBasic 4.5",RETURN.CODE%)
  1073.        GOSUB SCROLL.WAIT
  1074.  
  1075.        CALL SCROLL(9,15,16,65,1,-1," ",RETURN.CODE%)
  1076.        GOSUB SCROLL.WAIT
  1077.  
  1078.        CALL SCROLL(9,15,16,65,1,-1,"                        for",RETURN.CODE%)
  1079.        GOSUB SCROLL.WAIT
  1080.  
  1081.        CALL SCROLL(9,15,16,65,1,-1," ",RETURN.CODE%)
  1082.        GOSUB SCROLL.WAIT
  1083.  
  1084.        CALL SCROLL(9,15,16,65,1,-1,"                *  Window Tools  *",RETURN.CODE%)
  1085.  
  1086.        SECONDS!=8.0
  1087.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  1088.  
  1089.        CALL SCROLL(9,15,16,65,1,1,"             BY: James P. Morgan",RETURN.CODE%)
  1090.        GOSUB SCROLL.WAIT
  1091.  
  1092.        CALL SCROLL(9,15,16,65,1,1,"                 5226 Via Hacienda #115",RETURN.CODE%)
  1093.        GOSUB SCROLL.WAIT
  1094.  
  1095.        CALL SCROLL(9,15,16,65,1,1,"                 Orlando, FL 32809 U.S.A.",RETURN.CODE%)
  1096.        GOSUB SCROLL.WAIT
  1097.  
  1098.        CALL SCROLL(9,15,16,65,1,1," ",RETURN.CODE%)
  1099.        GOSUB SCROLL.WAIT
  1100.  
  1101.        CALL SCROLL(9,15,16,65,1,1," ",RETURN.CODE%)
  1102.        GOSUB SCROLL.WAIT
  1103.  
  1104.        CALL SCROLL(9,15,16,65,1,1,"   * based on original PD works by Dave Evers *",RETURN.CODE%)
  1105.  
  1106.        SECONDS!=30.0
  1107.        CALL WAITTIME(SECONDS!,RETURN.CODE%)
  1108.  
  1109.        COLOR 7,1
  1110.        LOCATE 22,9:PRINT "Please see accompanying file WINDTOOL.DOC for more information"
  1111.  
  1112.        SYSTEM
  1113.